home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0920.ZIP / TPSPL.ARC / TPSPOOL.PAS < prev   
Pascal/Delphi Source File  |  1987-12-23  |  8KB  |  255 lines
  1. {************************************************************************}
  2. {*                                                                      *}
  3. {* TPSPOOL - Print spooler                                              *}
  4. {* Alpha Test Version .6 12/6/87                                        *}
  5. {* by Richard Sadowsky                                                  *}
  6. {* Copyright (c) 1987, Richard Sadowsky                                 *}
  7. {* Released to the public domain                                        *}
  8. {************************************************************************}
  9. {* TPSPOOL size                                                         *}
  10. {* where size is the size of the spool buffer.  You may use hex numbers *}
  11. {* placing a $ in front (ex. $4000).                                    *}
  12. {*                                                                      *}
  13. {* Use Alt-Tab to toggle spooler on/off (default is off).               *}
  14. {* Turning spooler on will beep the speaker, turning it off will        *}
  15. {* dump the spool buffer.                                               *}
  16. {*                                                                      *}
  17. {************************************************************************}
  18. {$S-,I-,R-,V-}
  19. {$M 2048,0,655360} { program adjusts itself at runtime to use least }
  20.                        { possible amount of memory }
  21. program TPSpool;
  22.  
  23. {DEFINE debug}    { must define useCRT to use debug }
  24. {DEFINE useCRT}   { for debugging }
  25.  
  26. Uses DOS,
  27. { The following Units are from TurboPower's Turbo Professional 4.0 }
  28. {$IFDEF useCRT}
  29.      TPCrt,
  30. {$ENDIF}
  31.  
  32.      TPString,
  33.      TPInt,
  34.      TPTSR;
  35.  
  36. const
  37.   HotKey           = $080F;     { Alt/Tab }
  38.   WaitForDos       = TRUE;      { DOS services needed in popup }
  39.   SpoolBufSize     : Word = $FF00; { 65280 }
  40.   Int17_HANDLE     = 15;
  41.   SpoolOn          : Boolean = FALSE;
  42.   In_PopUp         : Boolean = FALSE;
  43.   ThisModule       : String[8] = 'TPSPOOL_0.6';
  44.   ProgID           =
  45.       'TPSPOOL .6 installed, press <Alt><Tab> to toggle spooler on/off';
  46.   OutFileName      : String[12] = 'SPOOL01.TMP';
  47.  
  48. type
  49.   Str20            = String[20];
  50.   SpoolBufType     = array[1..$FF00] of Byte;
  51.  
  52. var
  53.   TimerHandle      : Byte;
  54.   BetterDumpIt,SafeDumpSize,
  55.   SpoolIndex       : Word;
  56.   SpoolBuf (* ,EmergencySpoolBuf *)
  57.                    : ^SpoolBufType;
  58.   OutFile          : File;
  59.  
  60. function LongWMul(X,Y : Word) : LongInt;
  61. { multiplies two words and returns a longint, VERY FAST }
  62. Inline(
  63.   $5A/                   {pop    dx        ; get Y}
  64.   $58/                   {pop    ax        ; get x}
  65.   $F7/$E2);              {mul    dx        ; multiply Y*X return in DX:AX}
  66.  
  67. procedure DumpSpoolBuf;
  68. { Dump the spool buffer to disk if necessary }
  69. var
  70.   E                : Word;
  71.   Handle,Num       : Word;
  72.   FilePos          : LongInt;
  73.   P                : Pointer;
  74.  
  75. begin
  76.   InterruptsOff;
  77.   if SpoolIndex <= 1 then begin { if there's anything in the spooler }
  78.     InterruptsOn;
  79.     Exit; { nothing to dump }
  80.   end;
  81.  
  82.   Assign(OutFile,OutFileName);  { Open the spool file }
  83.   Reset(OutFile,1);
  84.   if IOresult <> 0 then
  85.     Rewrite(OutFile,1)          { not found so create it }
  86.   else
  87.     Seek(OutFile,FileSize(OutFile)); { prepare for appending }
  88.   BlockWrite(OutFile,SpoolBuf^[1],Pred(SpoolIndex),Num); { dump the buffer }
  89.   Close(OutFile);
  90.   InterruptsOff;
  91.   SpoolIndex := 1;  { reset spool index to beginning }
  92.   InterruptsOn;
  93. end;
  94.  
  95. {$F+}
  96. procedure PopUpEntry(var Regs : Registers);
  97. { User has pressed the hot key, so process it }
  98. begin
  99.   InterruptsOff;
  100.   In_PopUp := TRUE; { set semaphore for future multitasking }
  101.   InterruptsOn;
  102.   if SpoolBuf = NIL then   { if the spool buffer hasn't been allocated, }
  103.     GetMem(SpoolBuf,SpoolBufSize); { then allocate the memory on the heap }
  104.   SpoolOn := Not SpoolOn;  { toggle spooler }
  105.   if SpoolOn then begin
  106.  
  107. {$IFDEF useCRT}
  108.     { two tone beep at the user }
  109.     Sound(220);
  110.     Delay(600);
  111.     Sound(880);
  112.     Delay(300);
  113.     NoSound;
  114.  
  115. {$ELSE}
  116.  
  117.     Write(^G); { simple beep at user }
  118.  
  119. {$ENDIF}
  120.  
  121.   end
  122.   else
  123.     DumpSpoolBuf; { Spooler disabled so dump the buffer }
  124.   InterruptsOff;
  125.   In_PopUp := FALSE; { clear semaphore for future multitasking }
  126.   InterruptsOn;
  127. end;
  128. {$F-}
  129.  
  130. {$F+}
  131. procedure TimerISR(var Regs : Registers);
  132. { We have control and it's safe to call DOS, so check to see if the }
  133. { buffer needs dumping, and dump if necessary }
  134. begin
  135.   InterruptsOff;
  136.   if SpoolIndex > BetterDumpIt then begin { if the spooler needs dumping }
  137.     InterruptsOn;
  138.     DumpSpoolBuf; { dump it }
  139.   end
  140.   else
  141.     InterruptsOn;
  142. end;
  143. {$F-}
  144.  
  145. procedure Trap_Int17(BP : Word); interrupt;
  146. { If spooler is on, capture calls to ROM BIOS interrupt 17h, if the call is }
  147. { to print a character, add it to spool buffer. }
  148. var
  149.   Regs             : IntRegisters absolute BP;
  150.  
  151. begin
  152.  
  153.   if SpoolOn then begin { if spooler enabled then spool character }
  154.  
  155.     InterruptsOff;
  156.  
  157. {$IFDEF debug}
  158. { ******* Use this when debugging }
  159.     if SpoolIndex > SpoolBufSize - 1024 then begin
  160.       FastWrite(Pad(
  161.        'Crash approaching   SpoolIndex = '+Long2Str(SpoolIndex),80),25,1,$70);
  162.       if SpoolIndex >= SpoolBufSize then begin
  163.         InterruptsOn;
  164.         Exit;
  165.       end;
  166.     end;
  167.  
  168. {$ENDIF}
  169.  
  170.     SpoolBuf^[SpoolIndex] := Regs.Al; { put the character in the spool buf }
  171.     Inc(SpoolIndex);                  { increment index }
  172.  
  173.     if (SpoolIndex > BetterDumpIt) then { if buffer needs a-dumpin }
  174.       SetPopTicker(TimerHandle,36);     { try to gain access to DOS services }
  175.     Regs.Ah := $90;                     { set bits to indicate success }
  176.     InterruptsOn;
  177.  
  178.   end
  179.  
  180.   else
  181.     ChainInt(Regs,ISR_Array[Int17_HANDLE].OrigAddr); { just filter it }
  182.  
  183. end;
  184.  
  185. function InitISRs : Boolean;
  186. { Set's up ISRs and popup routines.  Also sets the buffer size. }
  187. var
  188.   Num  : Word;
  189.  
  190. begin
  191.   if ParamCount > 0 then    { if user specified a command line option }
  192.     if Str2Word(ParamStr(1),Num) then { is it a valid number? }
  193.       SpoolBufSize := Num;            { If so, set buffer size equal to it }
  194.   BetterDumpIt := SpoolBufSize Div 2; { Dump if greater than half full }
  195.  
  196.   SpoolIndex := 1; { point to first byte in spool buffer }
  197.   { now set up ISRs and popups }
  198.   InitISRs :=
  199.    { Hot key popup }
  200.    DefinePop(HotKey,@PopUpEntry,Ptr(SSeg,SPtr), WaitForDos) and
  201.  
  202.    { popup to allow buffer to be dumped }
  203.    DefinePopProc(TimerHandle,@TimerISR,Ptr(SSeg,SPtr)) and
  204.  
  205.    { Int 17h handler, traps calls to BIOS to print a character }
  206.    InitVector($17,Int17_HANDLE,@Trap_Int17)
  207. end;
  208.  
  209. var
  210.   ResidentSizeInParas : Word; { Number of paragraphs needed at runtime }
  211.   NumBytesUsed : LongInt;     { Number of bytes used at runtime }
  212.  
  213. begin { main }
  214.   if ModuleInstalled(ThisModule) then begin { already installed? }
  215.     WriteLn('TPSPOOL already installed.'); { already RAM resident }
  216.     Exit
  217.   end;
  218.   if InitISRs then begin { ISR and popups initialize OK? }
  219.     WriteLn(ProgID);     { Program ID }
  220.  
  221. {$IFDEF debug}
  222.     WriteLn('Debug On');
  223. {$ENDIF}
  224.  
  225. {$IFDEF useint21}
  226.     WriteLn('Using radical Int 21h handler');
  227. {$ENDIF}
  228.  
  229.     WriteLn('Spool file name: ',OutFileName); { display spool file name }
  230.     { tell the user the runtime size in bytes of this program }
  231.     WriteLn('Using ',SpoolBufSize,' byte spool buffer in RAM');
  232.     { Disable TPCrt's  Ctrl Break handler }
  233.  
  234. {$IFDEF useCRT}
  235.  
  236.     SetIntVec($1B, SaveInt1B); { mandatory if CRT or TPCRT are used }
  237.  
  238. {$ENDIF}
  239.  
  240.     InstallModule(ThisModule,NIL); { Set up shop, see TProf4 manual }
  241.     PopUpsOn; { enable the popup routines }
  242.     SpoolBuf := NIL; { initialize this to NIL }
  243.     { Calculate the number of paragraphs of RAM needed at runtime }
  244.     ResidentSizeInParas :=  ParagraphsToKeep + Succ(SpoolBufSize div 16);
  245.     { User could care less about paragraphs, tell them in bytes }
  246.     NumBytesUsed := LongWMul(ResidentSizeInParas,16);
  247.     WriteLn;
  248.     WriteLn('Going resident, using ',NumBytesUsed,' bytes');
  249.     { Let's go resident now }
  250.     if not TerminateAndStayResident(ResidentSizeInParas,0) then {do nothing};
  251.   end;
  252.  
  253.   WriteLn('Unable to install TPSPOOL.'); { something went wrong!!! }
  254. end. {main}
  255.